home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 026a / atbbsdbf.zip / NEW.FRG < prev    next >
Text File  |  1990-12-14  |  4KB  |  212 lines
  1. * Program............: D:\ATBBS\NEW.FRG
  2. * Date...............: 12-14-90
  3. * Versions...........: dBASE IV, Report 1.1
  4. *
  5. * Notes:
  6. * ------
  7. * Prior to running this procedure with the DO command
  8. * it is necessary use LOCATE because the CONTINUE
  9. * statement is in the main loop.
  10. *
  11. *-- Parameters
  12. PARAMETERS gl_noeject, gl_plain, gl_summary, gc_heading, gc_extra
  13. ** The first three parameters are of type Logical.
  14. ** The fourth parameter is a string.  The fifth is extra.
  15. PRIVATE _peject, _wrap
  16.  
  17. *-- Test for no records found
  18. IF EOF() .OR. .NOT. FOUND()
  19.    RETURN
  20. ENDIF
  21.  
  22. *-- turn word wrap mode off
  23. _wrap=.F.
  24.  
  25. IF _plength < (_pspacing * 7 + 1) + (_pspacing * 2 + 1) + 2
  26.    SET DEVICE TO SCREEN
  27.    DEFINE WINDOW gw_report FROM 7,17 TO 11,62 DOUBLE
  28.    ACTIVATE WINDOW gw_report
  29.    @ 0,1 SAY "Increase the page length for this report."
  30.    @ 2,1 SAY "Press any key ..."
  31.    x=INKEY(0)
  32.    DEACTIVATE WINDOW gw_report
  33.    RELEASE WINDOW gw_report
  34.    RETURN
  35. ENDIF
  36.  
  37. _plineno=0          && set lines to zero
  38. *-- NOEJECT parameter
  39. IF gl_noeject
  40.    IF _peject="BEFORE"
  41.       _peject="NONE"
  42.    ENDIF
  43.    IF _peject="BOTH"
  44.       _peject="AFTER"
  45.    ENDIF
  46. ENDIF
  47.  
  48. *-- Set-up environment
  49. ON ESCAPE DO Prnabort
  50. IF SET("TALK")="ON"
  51.    SET TALK OFF
  52.    gc_talk="ON"
  53. ELSE
  54.    gc_talk="OFF"
  55. ENDIF
  56. gc_space=SET("SPACE")
  57. SET SPACE OFF
  58. gc_time=TIME()      && system time for predefined field
  59. gd_date=DATE()      && system date  "    "    "     "
  60. gl_fandl=.F.        && first and last page flag
  61. gl_prntflg=.T.      && Continue printing flag
  62. gl_widow=.T.        && flag for checking widow bands
  63. gn_length=LEN(gc_heading)  && store length of the HEADING
  64. gn_level=2          && current band being processed
  65. gn_page=_pageno     && grab current page number
  66. gn_pspace=_pspacing && get current print spacing
  67.  
  68.  
  69. *-- Set up procedure for page break
  70. gn_atline=_plength - (_pspacing * 2 + 1)
  71. ON PAGE AT LINE gn_atline EJECT PAGE
  72.  
  73. *-- Print Report
  74.  
  75. PRINTJOB
  76.  
  77. IF gl_plain
  78.    ON PAGE AT LINE gn_atline DO Pgplain
  79. ELSE
  80.    ON PAGE AT LINE gn_atline DO Pgfoot
  81. ENDIF
  82.  
  83. DO Pghead
  84.  
  85. gl_fandl=.T.        && first physical page started
  86.  
  87. *-- File Loop
  88. DO WHILE FOUND() .AND. .NOT. EOF() .AND. gl_prntflg
  89.    gn_level=0
  90.    *-- Detail lines
  91.    IF gl_summary
  92.       DO Upd_Vars
  93.    ELSE
  94.       DO __Detail
  95.    ENDIF
  96.    gl_widow=.T.         && enable widow checking
  97.    CONTINUE
  98. ENDDO
  99.  
  100. IF gl_prntflg
  101.    gl_fandl=.F.     && last page finished
  102.    IF _plineno <= gn_atline
  103.       EJECT PAGE
  104.    ENDIF
  105. ELSE
  106.    DO Reset
  107.    RETURN
  108. ENDIF
  109.  
  110. ON PAGE
  111.  
  112. ENDPRINTJOB
  113.  
  114. DO Reset
  115. RETURN
  116. * EOP: D:\ATBBS\NEW.FRG
  117.  
  118. *-- Update summary fields and/or calculated fields.
  119. PROCEDURE Upd_Vars
  120. RETURN
  121. * EOP: Upd_Vars
  122.  
  123. *-- Set flag to get out of DO WHILE loop when escape is pressed.
  124. PROCEDURE Prnabort
  125. gl_prntflg=.F.
  126. RETURN
  127. * EOP: Prnabort
  128.  
  129. PROCEDURE Pghead
  130. ?? IIF(gl_plain,'',gd_date) AT 0,;
  131.  "NEW FILES ON THE ATBBS" AT 29,;
  132.  gc_time FUNCTION "T" AT 72
  133. ?
  134. ?
  135. ?
  136. ?
  137.  
  138. *-- Print HEADING parameter ie. REPORT FORM <name> HEADING <expC>
  139. IF .NOT. gl_plain .AND. gn_length > 0
  140.    ?? gc_heading FUNCTION "I;V"+LTRIM(STR(_rmargin-_lmargin))
  141.    ?
  142. ENDIF
  143. ?? "LIBRARY" AT 0,;
  144.  "FILE NAME" AT 12,;
  145.  "BYTES" AT 28,;
  146.  "DESCRIPTION" AT 40
  147. ?
  148. ?? "--------" AT 0,;
  149.  "------------" AT 12,;
  150.  "--------" AT 28,;
  151.  "----------------------------------------" AT 40
  152. ?
  153. ?
  154. RETURN
  155. * EOP: Pghead
  156.  
  157.  
  158. PROCEDURE __Detail
  159. IF gn_pspace < gn_atline - (_pspacing * 7 + 1)
  160.    IF gl_widow .AND. _plineno+gn_pspace > gn_atline + 1
  161.       EJECT PAGE
  162.    ENDIF
  163. ENDIF
  164. DO Upd_Vars
  165. ?? Library FUNCTION "T" AT 0,;
  166.  File FUNCTION "T" AT 12,;
  167.  Bytes FUNCTION "T" AT 28,;
  168.  Descrip FUNCTION "T" AT 40
  169. ?
  170. RETURN
  171. * EOP: __Detail
  172.  
  173.  
  174. PROCEDURE Pgfoot
  175. PRIVATE _box, _pspacing
  176. gl_widow=.F.         && disable widow checking
  177. _pspacing=1
  178. ?
  179. IF .NOT. gl_plain
  180. ?
  181. ENDIF
  182. EJECT PAGE
  183. *-- is the page number greater than the ending page
  184. IF _pageno > _pepage
  185.    GOTO BOTTOM
  186.    SKIP
  187.    gn_level=0
  188. ENDIF
  189. IF .NOT. gl_plain .AND. gl_fandl
  190.    _pspacing=gn_pspace
  191.    DO Pghead
  192. ENDIF
  193. RETURN
  194. * EOP: Pgfoot
  195.  
  196. *-- Process page break when PLAIN option is used.
  197. PROCEDURE Pgplain
  198. PRIVATE _box
  199. EJECT PAGE
  200. RETURN
  201. * EOP: Pgplain
  202.  
  203. *-- Reset dBASE environment prior to calling report
  204. PROCEDURE Reset
  205. SET SPACE &gc_space.
  206. SET TALK &gc_talk.
  207. ON ESCAPE
  208. ON PAGE
  209. RETURN
  210. * EOP: Reset
  211.  
  212.